home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / scope / 051-075 / scopedisk69 / jlib20a / demo < prev    next >
Encoding:
Text File  |  1995-03-19  |  17.3 KB  |  512 lines
  1.   ON BREAK GOSUB abort:BREAK ON
  2. '  WINDOW 1,,(0,0)-(617,186),31,-1
  3.   WINDOW 1,,(417,11)-(617,59),31,-1
  4.   DEFINT a-z
  5.  
  6. '========== the jlib variable table - MUST NOT BE ALTERED!!!
  7.   jlib&=0
  8.   about&=0:w7&=0:bye&=0:getmem&=0:freemem&=0:zip&=0:copy&=0:anycmd&=0'jlib/exec
  9.   at&=0:text&=0:printat&=0:shadow&=0:sxy&=0:scolr&=0            'graphics
  10.   sbox&=0:dbox&=0:drawmode&=0:rgb&=0:blowup&=0
  11.   title&=0:autoreq&=0:refresh&=0:setptr&=0:clrptr&=0:sgad&=0    'intuition
  12.   exp1&=0:exp2&=0:exp3&=0:exp4&=0:exp5&=0:exp6&=0:exp7&=0:exp8&=0:exp9&=0
  13.   bload&=0:bsave&=0:openDOS&=0:DOSfile&=0:closeDOS&=0           'dos
  14.   checkfile&=0:request&=0:DOScmd&=0
  15.   loadiff&=0:saveIFF&=0:load8svx&=0:play8svx&=0:kill8svx&=0     'iff/8svx
  16.   loadfont&=0:usefont&=0:killfont&=0:style&=0                   'font
  17.  
  18. '========== these are highly recommended - but not required
  19.   nl$=CHR$(0):nl3$=STRING$(3,0)
  20.  
  21. '========== load and set up the jlib file
  22.   OPEN "jlib.ldr" FOR INPUT AS #1
  23.      mlsize=LOF(1)/2-1:DIM ml(mlsize)
  24.      FOR i=0 TO mlsize:ml(i)=CVI(INPUT$(2,1)):NEXT
  25.   CLOSE #1
  26.   ml&=VARPTR(ml(0)):ml& SADD("jlib2"+nl$),VARPTR(jlib&),WINDOW(7)  ':ERASE ml
  27.  
  28. '========== save a copy of original color table
  29.   getmem& 64,65536&,0:orgRGB&=jlib&:rgb& 0,orgRGB&,0,32
  30.   getmem& 64,65536&,0:cRGB&=jlib&      'temp storage for cycle SUB
  31.  
  32. '========== load fonts
  33.   title& SADD("Loading fonts..."+nl$)
  34.   loadfont& SADD("topaz"+nl$),8:topaz8&=jlib&
  35.   loadfont& SADD("garnet"+nl$),16:garnet16&=jlib&
  36.  
  37. '========== set up jlib mouse pointer
  38.   getmem& 80,65539&,0:ptr&=jlib&
  39.   bload& SADD("jlib.p"+nl$),ptr&,80
  40.  
  41. '========== do title screen
  42.   WINDOW CLOSE 1
  43.   getmem& 640,65536&,0:newRGB&=jlib&
  44.   bload& SADD("RGB"+nl$),newRGB&,640
  45.   IF jlib&<>640 THEN PRINT jlib&:GOTO slowquit
  46.   SCREEN 1,320,200,5,1
  47.   WINDOW 2,,,16,1
  48.   w7& WINDOW(7)
  49.   setptr& ptr&,-1
  50.   loadiff& SADD("jlib.pic"+nl$)
  51.   GOSUB cyclepic
  52.   rgb& 1,newRGB&+2*64,0,32
  53.  
  54. '========== demo ColorMaster and various rgb& functions/possibilities
  55.   WINDOW 3,"jlib demo:  ",(10,40)-(301,150),0,1
  56.   w7& WINDOW(7):setptr& ptr&,-1:scolr& 11,9:sxy& 1,1
  57.   shadow& -1,5,SADD("You have just seen how jlib can"+nl$)
  58.   shadow& -1,15,SADD("load an iff picture and some"+nl$)
  59.   shadow& -1,25,SADD("color cycling possibilities."+nl$)
  60.   shadow& -1,45,SADD("Now click the mouse to bring"+nl$)
  61.   shadow& -1,55,SADD("up ColorMaster, which is a"+nl$)
  62.   shadow& -1,65,SADD("palette requester subroutine."+nl$)
  63.   shadow& -1,85,SADD("ColorMaster demonstrates several"+nl$)
  64.   shadow& -1,95,SADD("more of the rgb& functions."+nl$)
  65.   CALL whoa
  66.   WINDOW CLOSE 3:w7& WINDOW(7)
  67.   scrn=1:GOSUB cmaster
  68.  
  69. '========== MoveScreen& with anycmd&
  70.   scrn&=PEEKL(WINDOW(7)+46)
  71. '                 offset -162 in intuition.library (a6=1) is MoveScreen&
  72.   FOR i=0 TO 210:anycmd& -162,0,1,2,3,4,5,6,7,scrn&,1,2,3,4,5,1:NEXT
  73.   WINDOW 3,"jlib demo:  ",(50,22)-(581,170),0,-1
  74.   w7& WINDOW(7):setptr& ptr&,-1:scolr& 1,2:sxy& 5,2
  75.   POKE WINDOW(7)+98,3:POKE WINDOW(7)+99,2:refresh&
  76.   shadow& -1,5,SADD("The title screen was slid down by using `anycmd& to call the'"+nl$)
  77.   shadow& -1,15,SADD("Intuition function `MoveScreen'.  `anycmd&' can be used to call"+nl$)
  78.   shadow& -1,25,SADD("any library function not directly supported by a jlib command..."+nl$)
  79.   shadow& -1,35,SADD("and still without the need of a BMAP!"+nl$)
  80.   shadow& -1,50,SADD("Now I will demonstrate a new jlib function called blowup&."+nl$)
  81.   shadow& -1,60,SADD("This function will `blowup', or enlarge a section of the display"+nl$)
  82.   shadow& -1,70,SADD("and could be useful for such things as editor screens, etc."+nl$)
  83.   shadow& -1,85,SADD("During this part of the demo you will be able to click in the"+nl$)
  84.   shadow& -1,95,SADD("title screen window and the area around where you click"+nl$)
  85.   shadow& -1,105,SADD("will be blown up into the smaller window."+nl$)
  86.   shadow& -1,120,SADD("To continue from there, click in that smaller window."+nl$)
  87.   shadow& -1,135,SADD("CLICK MOUSE TO CONTINUE"+nl$):whoa
  88.   WINDOW CLOSE 3
  89.   anycmd& -336,0,1,2,3,4,5,6,7,0,1,2,3,4,5,1  'WBenchToBack&
  90.   FOR i=0 TO 210:anycmd& -162,0,-1,2,3,4,5,6,7,scrn&,1,2,3,4,5,1:NEXT
  91.  
  92. '========== demo blowup& function
  93.   rp1&=WINDOW(8)
  94.   WINDOW 3,"",(211,0)-(311,100),2,1
  95.   w7& WINDOW(7)
  96.   rgb& 1,newRGB&+2*64,0,32
  97. bloop:
  98.   whoa
  99.   x=MOUSE(3)-10
  100.   y=MOUSE(4)-10
  101.   blowup& rp1&,x,y,20,20,WINDOW(8),0,0,5,3
  102.   IF WINDOW(0)<>3 THEN bloop
  103.   WINDOW CLOSE 3
  104.  
  105. '========== rainbow text demo
  106. rbow:
  107.   CLS
  108.   w7& WINDOW(7)
  109.   rgb& 1,orgRGB&,0,32
  110.  
  111. 'here's another way to do a color table!
  112.   DIM rbows(7):FOR i=0 TO 7:READ msg$:rbows(i)=VAL("&h"+msg$):NEXT
  113.   rgb& 1,VARPTR(rbows(0)),0,8
  114.   DATA 000,aaa,f00,f80,ff0,0f0,00f,f0f
  115.  
  116.   x=-1:y=65:rainbow 0,x,y,"Rainbow Text!":i=x/2:temp=x/5
  117.   blowup& WINDOW(8),x,y,104,8,WINDOW(8),temp,5,5,3
  118.   blowup& WINDOW(8),x,y,104,8,WINDOW(8),i,45,2,0
  119.   rainbow 1,-1,75,"(not a jlib function)"
  120.   rainbow 2,-1,85,"(just a neat trick!)"
  121.  
  122.   usefont& garnet16&
  123.   x=-1:y=100:rainbow 3,x,y,"Rainbow Text!"
  124.   blowup& WINDOW(8),x-17,y-1,156,18,WINDOW(8),0,120,2,0
  125.  
  126.   usefont& topaz8&
  127. '  rainbow 4,-1,165,"Poke the rodent in the eye!"
  128.   rainbow 4,-1,175,"(click the mouse button)"
  129.  
  130.   WHILE MOUSE(0)<>0:WEND
  131.   WHILE MOUSE(0)=0:cycle 2,6:WEND
  132.   scrn&=PEEKL(WINDOW(7)+46)
  133.   FOR i=0 TO 26
  134.     anycmd& -162,0,8,2,3,4,5,6,7,scrn&,1,2,3,4,5,1
  135.     cycle 2,6
  136.   NEXT
  137.   WINDOW CLOSE 2
  138.   SCREEN CLOSE 1
  139.  
  140. '========== about&
  141.   WINDOW 2,"jlib demo:",(0,0)-(631,186),16,-1
  142.   w7& WINDOW(7):POKE WINDOW(7)+99,3:refresh&
  143.   setptr& ptr&,-1
  144.   about&
  145.  
  146. '========== text demo
  147.   title& SADD("Here are some text commands..."+nl$)
  148.   CLS
  149.   usefont& garnet16&
  150.   COLOR 1
  151.   at& 0,20:text& SADD("`at&' and `text&' position and print text."+nl$)
  152.   printat& 0,26,SADD("However, since both will almost always be used together,"+nl$)
  153.   printat& 0,42,SADD("`printat&' might be a better choice, as it combines the two."+nl$)
  154.   printat& -1,58,SADD("Also, both `printat&' and `shadow&' offer automatic text centering"+nl$)
  155.   printat& -1,74,SADD("if the x coordinate is equal to -1,"+nl$)
  156.   printat& -2,90,SADD("or right-justification"+nl$)
  157.   printat& -2,106,SADD("if the x coordinate is equal to -2,"+nl$)
  158.   printat& -1,122,SADD("They also compensate for the font's baseline,"+nl$)
  159.   printat& -1,138,SADD("so that the x,y coordinates always define the upper left corner."+nl$)
  160.   COLOR 3:sbox& -1,160,SADD("Click Mouse"+nl$):whoa
  161.  
  162. '========== shadow text
  163.   CLS
  164.   title& SADD("More text commands..."+nl$)
  165.   shadow& -1,0,SADD("Which brings us to `shadow&'!"+nl$)
  166.   shadow& -1,20,SADD("(Doesn't it dress up a display?)"+nl$)
  167.   shadow& 20,45,SADD("Shadow"+nl$)
  168.   scolr& 3,2:shadow& 96,45,SADD("foreground"+nl$)
  169.   scolr& 1,2:shadow& 200,45,SADD("and"+nl$)
  170.   scolr& 1,3:shadow& 240,45,SADD("background"+nl$)
  171.   scolr& 1,2:shadow& 350,45,SADD("may be changed with `scolr&'."+nl$)
  172.   shadow& -1,65,SADD("`scolr&' is independant of BASIC's colors"+nl$)
  173.   shadow& -1,80,SADD("and returns you to them after shadow printing."+nl$)
  174.   scolr& 1,2:sxy& -5,-2:COLOR 2
  175.   shadow& -1,100,SADD("(The shadow's position may also be adjusted with `sxy&'.)"+nl$)
  176.   usefont& topaz8&:scolr& 1,2:sxy& 5,2
  177.   shadow& -1,125,SADD("The text's style may also be changed!"+nl$)
  178.   style& 1:shadow& 128,135,SADD("Underlined,"+nl$)
  179.   style& 2:shadow& 224,135,SADD("bold,"+nl$)
  180.   style& 4:shadow& 272,135,SADD("italics,"+nl$)
  181.   style& 7:shadow& 344,135,SADD("or any combination"+nl$)
  182.   style& 0:shadow& -1,145,SADD("of text may be selected using `style&'."+nl$)
  183.   usefont& garnet16&
  184.   COLOR 3,1:dbox& -1,160,SADD("Click Mouse!"+nl$):whoa
  185.  
  186. '========== drawmode and gadgety things
  187.   title& SADD("Drawmode can be changed with `drawmode&'..."+nl$)
  188.   drawmode& 2:FOR i=0 TO 186:LINE (0,186-i)-(630,186-i):NEXT:pause 2!
  189.   title& SADD("Boxes..."+nl$)
  190.   drawmode& 1:FOR i=0 TO 186:LINE (0,i)-(630,i),2:NEXT
  191.   scolr& 1,0
  192.   shadow& -1,5,SADD("There are also two types of boxes"+nl$)
  193.   shadow& -1,25,SADD("that may be drawn around your text."+nl$)
  194.   usefont& topaz8&
  195.   scolr& 1,2
  196.   COLOR 3,0:sbox& 20,49,SADD("This is sbox&"+nl$)
  197.   COLOR 0,1:dbox& 481,49,SADD("This is dbox&"+nl$)
  198.   usefont& garnet16&
  199.   COLOR 3,0:sbox& 20,68,SADD("This is sbox&"+nl$)
  200.   COLOR 0,1:dbox& 467,68,SADD("This is dbox&"+nl$)
  201.   scolr& 3,0
  202.   shadow& -1,47,SADD("The boxes are automatically"+nl$)
  203.   shadow& -1,62,SADD("sized around whatever"+nl$)
  204.   shadow& -1,77,SADD("font is being used."+nl$)
  205.   shadow& -1,92,SADD("The x,y coordinates point to the top left corner of the box."+nl$)
  206.   scolr& 1,0
  207.   COLOR 3,0:sbox& -1,116,SADD("Let's get some letters with descenders"+nl$)
  208.   COLOR 0,1:dbox& -1,140,SADD("so you can see why there was extra space in those boxes!"+nl$)
  209.   scolr& 1,3:shadow& -1,164,SADD("Click Mouse!"+nl$):whoa
  210.  
  211. '========== ARP requester
  212.   COLOR 1,0:CLS
  213.   POKE WINDOW(7)+98,3
  214.   POKE WINDOW(7)+99,2
  215.   refresh&
  216.   title& SADD("Testing the ARP File Requester..."+nl$)
  217.   sxy& 2,1:scolr& 1,2
  218.   shadow& -1,5,SADD("Select any file..."+nl$)
  219.   shadow& -1,20,SADD("(Try pressing right mouse button, too!)"+nl$)
  220.   file$="df0:"+STRING$(350,0)
  221.   request& 20,50,SADD("ARP Requester - first color"+nl$),SADD(file$),0
  222.   file$=LEFT$(file$,INSTR(file$,CHR$(0))-1)
  223.   IF file$="" THEN file$="No file selected!"
  224.   shadow& 0,40,SADD(file$+nl$)
  225.   file$="df0:"+STRING$(350,0)
  226.   request& 300,50,SADD("ARP Requester - second color"+nl$),SADD(file$),1
  227.   file$=LEFT$(file$,INSTR(file$,CHR$(0))-1)
  228.   IF file$="" THEN file$="No file selected!"
  229.   shadow& 0,55,SADD(file$+nl$)
  230.   pause 3!
  231.  
  232. '========== autorequesters, string gadgets
  233.   CLS
  234.   usefont& topaz8&
  235.   POKE WINDOW(7)+99,1:refresh&
  236.   drawmode& 0:sxy& 5,2:scolr& 1,2
  237.   title& SADD("Autorequesters!"+nl$)
  238.        msg$="This is how you build"+nl$
  239.   msg$=msg$+"an AutoRequester (you"+nl$
  240.   msg$=msg$+"need to be looking at"+nl$
  241.   msg$=msg$+"the source to see it,"+nl$
  242.   msg$=msg$+"of course!)"+nl3$          'notice nl3$ at end
  243.   autoreq& SADD(msg$),SADD("LEFT"+nl$),SADD("RIGHT"+nl$)
  244.   shadow& 300,0,SADD("You pressed "+MID$("RIGHTLEFT",5*jlib&+1,5)+nl$)
  245.   autoreq& SADD("Please press another button!"+nl3$),SADD("LEFT"+nl$),SADD("RIGHT"+nl$)
  246.   shadow& 444,0,SADD("- You pressed "+MID$("RIGHTLEFT",5*jlib&+1,5)+nl$)
  247.   title& SADD("String Gadgets, too!"+nl$)
  248.   shadow& 0,15,SADD("Enter your name:"+nl$)
  249.   COLOR 3:dbox& 150,11,SADD(SPACE$(20)+nl$)
  250.   msg$="john everett"+STRING$(41,0)  'theres xtra space here
  251.   sgad& 158,15,160,8,41,0,SADD(msg$)
  252.   msg$=LEFT$(msg$,INSTR(msg$,nl$)) 'nl$)-1) if you don't want NULL terminator
  253.   shadow& 0,30,SADD("You typed: "+msg$)
  254.   shadow& -1,40,SADD("I've left the drawing of a border around the gadget"+nl$)
  255.   shadow& -1,50,SADD("to you, so that you can custom-design your screens easier."+nl$)
  256.   shadow& -1,60,SADD("For instance, if you wanted an iff pic for a data entry screen,"+nl$)
  257.   shadow& -1,70,SADD("a border might destroy part of your picture."+nl$)
  258.   shadow& -1,80,SADD("You could use a LINE command or dbox& if you just needed a simpler border."+nl$)
  259.   shadow& -1,95,SADD("Integer gadgets are also supported for numeric entry."+nl$)
  260.   shadow& 0,110,SADD("Enter a number:"+nl$)
  261.   LINE (129,109)-STEP(81,9),3,b
  262.   msg$=STRING$(11,0)
  263.   sgad& 130,110,80,8,11,5,SADD(msg$)
  264.   msg$=LEFT$(msg$,INSTR(msg$,nl$))
  265.   shadow& 220,110,SADD("You entered: "+msg$)  'integer gadgets also return their value in jlib&
  266.   shadow& -1,125,SADD("Left, center, and right-justification"+nl$)
  267.   shadow& -1,135,SADD("inside the gadget are also supported."+nl$)
  268.   shadow& 0,150,SADD("Enter anything:"+nl$)
  269.   LINE (129,149)-STEP(161,9),3,b
  270.   msg$="anything"+STRING$(21,0)
  271.   sgad& 130,150,160,8,21,2,SADD(msg$)
  272.   msg$=LEFT$(msg$,INSTR(msg$,nl$))
  273.   shadow& 320,150,SADD("You entered: "+msg$)
  274.   shadow& -1,170,SADD("Click Mouse!"+nl$):whoa
  275.  
  276. '========== DOScmd&
  277.   CLS
  278.   title& SADD("More jlib demo..."+nl$)
  279.   shadow& 0,10,SADD("Testing DOScmd& `dir > ram:temp'..."+nl$)
  280.   DOScmd& SADD("dir > ram:temp"+nl$)
  281.   OPEN "ram:temp" FOR INPUT AS #1
  282.     i=20
  283.     WHILE NOT EOF(1)
  284.       LINE INPUT #1,msg$
  285.       shadow& 0,i,SADD(msg$+nl$)
  286.       i=i+10
  287.     WEND
  288.   CLOSE 1:KILL "ram:temp"
  289.   shadow& 0,i+10,SADD("CLICK MOUSE"+nl$):whoa
  290.  
  291. '======== finish
  292.   WINDOW CLOSE 2
  293.   SCREEN 1,320,200,5,1
  294.   WINDOW 3,"CLICK MOUSE IN WINDOW...",(30,40)-(291,120),0,1
  295.   w7& WINDOW(7)
  296.   shadow& -1, 5,SADD("Well, that's about it!"+nl$)
  297.   shadow& -1,15,SADD("Experiment and have fun!"+nl$)
  298.   shadow& -1,25,SADD("I'll send you back to the title"+nl$)
  299.   shadow& -1,35,SADD("screen and you can play with"+nl$)
  300.   shadow& -1,45,SADD("colors using the numeric"+nl$)
  301.   shadow& -1,55,SADD("keypad, or you can press the"+nl$)
  302.   shadow& -1,65,SADD("ESCape key to quit."+nl$)
  303.   GOSUB cyclemouse
  304.   WINDOW CLOSE 3
  305.   WINDOW 4,,,16,1
  306.   w7& WINDOW(7)
  307.   setptr& ptr&,-1
  308.   loadiff& SADD("jlib.pic"+nl$)
  309.   colr=2
  310. eloop:
  311.   GOSUB cyclepic
  312.   IF key$="" THEN key$=MID$("PDWROYGBV",INT(9*RND)+1,1)
  313.   IF key$=CHR$(27) THEN quit
  314.   IF VAL(key$)>0 THEN colr=VAL(key$) ELSE colr=INSTR("PDWROYGBV",key$)
  315.   IF key$="P" THEN colr=9
  316.   GOTO eloop
  317.  
  318. cyclepic:
  319.   IF colr>1 THEN
  320.     copy& newRGB&+colr*64,newRGB&,32,2
  321.     copy& newRGB&+colr*64,newRGB&+64,32,2
  322.   END IF
  323.   IF MOUSE(0)<>0 THEN WHILE MOUSE(0)<>0:WEND
  324.   key$="":showtime!=TIMER+10
  325.   WHILE MOUSE(0)=0 AND key$="" AND TIMER<showtime!
  326.     rgb& 1,newRGB&,0,32
  327.     IF colr<2 THEN
  328.       copy& newRGB&+3*64+2*count,newRGB&,32,2
  329.       count=count+1:IF count MOD 32=0 THEN count=32*INT(6*RND)
  330.     ELSE
  331.       temp=PEEKW(newRGB&)
  332.       copy& newRGB&+2,newRGB&,31,2
  333.       POKEW newRGB&+62,temp
  334.     END IF
  335.     key$=UCASE$(INKEY$)
  336.   WEND
  337.   RETURN
  338.  
  339. '========== cycle mouse pointer
  340. cyclemouse:
  341.   setptr& ptr&,-1
  342.   rgb& 1,ptr&+74,17,3        'if you want to load the .p file's colors
  343.   getmem& 12,65537&,1:p&=jlib&
  344.   rgb& 0,p&,17,3:copy& p&,p&+6,3,2
  345.   pause 1!:i=MOUSE(0)
  346.   WHILE MOUSE(0)=0
  347.     temp=PEEKW(p&):copy& p&+2,p&,2,2:POKEW p&+4,temp
  348.     rgb& 1,p&,17,3:pause .1
  349.   WEND
  350.   rgb& 1,p&+6,17,3
  351.   freemem& p&
  352.   RETURN
  353.  
  354. '========== ColorMaster subroutine
  355. cmaster:
  356.   IF scrn=0 THEN scrn=-1
  357.   WINDOW 8,"Color Master ",(100,40)-(237,132),18,scrn
  358.   w7& WINDOW(7)
  359. '========== if this is the first time through, then set up color tables
  360.   IF undoRGB&=0 THEN
  361.     getmem& 64,65537&,0:undoRGB&=jlib& 'for undo function
  362.     DIM colr(2)
  363.   END IF
  364. '========== set up undo buffer and draw requester
  365.   rgb& 0,undoRGB&,0,32
  366.   FOR y=0 TO 3
  367.     FOR x=0 TO 7
  368.       z=(8*y+x) AND WINDOW(6) 'eliminates illegal color values
  369.       IF 8*y+x=colr THEN LINE (17*x+1,10*y+39)-STEP(17,10),WINDOW(6)-colr-(colr=WINDOW(6)),bf
  370.       LINE (17*x+3,10*y+40)-STEP(13,8),z,bf
  371.     NEXT
  372.   NEXT
  373.   COLOR 3,0
  374.   sbox& 0,81,SADD("reset"+nl$)
  375.   sbox& 53,81,SADD("undo"+nl$)
  376.   sbox& 98,81,SADD(" ok "+nl$)
  377.   rgb& 2,VARPTR(colr(0)),colr,1
  378.   FOR z=0 TO 2:GOSUB slider:NEXT
  379. '========== the requester loop
  380. cloop:
  381.   whoa
  382.   IF WINDOW(0)<>8 THEN cloop
  383.   IF MOUSE(4)<39 THEN
  384.     z=INT(MOUSE(4)/13)
  385.     WHILE MOUSE(0)<0
  386.       colr(z)=(MOUSE(1)-18)/8
  387.       IF colr(z)<0 THEN colr(z)=0
  388.       IF colr(z)>15 THEN colr(z)=15
  389.       rgb& 3,VARPTR(colr(0)),colr,1
  390.       GOSUB slider
  391.     WEND
  392.   ELSEIF MOUSE(4)>80 THEN
  393.     IF MOUSE(3)<50 THEN            'reset
  394.       rgb& 1,orgRGB&,0,32
  395.       rgb& 2,VARPTR(colr(0)),colr,1
  396.       FOR z=0 TO 2:GOSUB slider:NEXT
  397.     ELSEIF MOUSE(3)>95 THEN        'ok
  398.       WINDOW CLOSE 8
  399.       w7& WINDOW(7)
  400.       RETURN
  401.     ELSE                           'undo
  402.       rgb& 1,undoRGB&,0,32
  403.       rgb& 2,VARPTR(colr(0)),colr,1
  404.       FOR z=0 TO 2:GOSUB slider:NEXT
  405.     END IF
  406.   ELSE
  407.     y=INT(colr/8):x=colr-8*y
  408.     LINE (17*x+1,10*y+39)-STEP(17,10),0,bf
  409.     LINE (17*x+3,10*y+40)-STEP(13,8),colr,bf
  410.     x=INT((MOUSE(3)-1)/17):y=INT((MOUSE(4)-40)/10)
  411.     colr=(8*y+x) AND WINDOW(6)
  412.     y=INT(colr/8):x=colr-8*y:IF colr=WINDOW(6) THEN z=1 ELSE z=WINDOW(6)-colr
  413.     LINE (17*x+1,10*y+39)-STEP(17,10),z,bf
  414.     LINE (17*x+3,10*y+40)-STEP(13,8),colr,bf
  415.     rgb& 2,VARPTR(colr(0)),colr,1
  416.     FOR z=0 TO 2:GOSUB slider:NEXT
  417.   END IF
  418.   GOTO cloop
  419. slider:
  420.   sbox& 0,13*z,SADD(HEX$(colr(z))+nl$)
  421.   LINE (8*colr(z)+19,13*z)-(138,13*z+11),0,bf
  422.   LINE (18,13*z)-STEP(8*colr(z),11),3,bf
  423.   RETURN
  424.  
  425. slowquit:
  426.   BEEP:whoa
  427. '  autoreq& SADD("SLOWQUIT"+nl3$),SADD("OK"+nl$),SADD("OK"+nl$)
  428. quit:
  429.   WINDOW CLOSE 2
  430.   SCREEN CLOSE 1
  431.   WINDOW 1,"Bye!",(417,11)-(617,59),31,-1
  432.   IF bye&>0 THEN
  433.     w7& WINDOW(7)
  434.     killfont& topaz8&
  435.     killfont& garnet16&
  436.     rgb& 1,orgRGB&,0,32   'replace original colors
  437.     bye&
  438.   END IF
  439.   END
  440. abort:RETURN quit
  441.  
  442. SUB whoa STATIC
  443.   SHARED bye&
  444.   WHILE MOUSE(0)<>0:WEND
  445.   WHILE MOUSE(0)=0:SLEEP:WEND
  446. END SUB
  447.  
  448. SUB pause(delay!) STATIC
  449.   delay!=delay!+TIMER
  450.   WHILE MOUSE(0)<>0:WEND
  451.   WHILE TIMER<delay! AND MOUSE(0)=0:WEND
  452. END SUB
  453.  
  454. SUB rainbow(style,x,y,text$) STATIC
  455.   SHARED anycmd&,drawmode&,printat&,blowup&,nl$,ml(),bye&
  456.   length=8*LEN(text$)
  457.   IF x=-1 THEN x=(WINDOW(2)-length)/2
  458.   COLOR 0,1
  459.   drawmode& 1
  460.   ON style+1 GOTO z0,z1,z2,z3,z4
  461. z0:
  462.   LINE (x,y)-STEP(length-1,0),2
  463.   FOR i=2 TO 7:LINE (x,i+y-1)-STEP(length-1,0),i:NEXT
  464.   LINE (x,y+7)-STEP(length-1,0),7
  465.   GOTO endit
  466. z1:
  467.   FOR i=2 TO 7:LINE (x+i-2,y)-STEP(0,7),i:NEXT
  468.   GET(x,y)-(x+7,y+7),ml
  469.   FOR i=0 TO length/6-1:PUT(x+6*i,y),ml,PSET:NEXT
  470.   GOTO endit
  471. z2:
  472.   LINE (x,y)-(x+7,y+7),2,bf
  473.   FOR i=0 TO 5
  474.     LINE (x,y+7-i)-(x+7-i,y),7-i
  475.     LINE (x+i,y+7)-(x+7,y+i),7-i
  476.   NEXT
  477.   GOTO finish
  478. z3:
  479.   length=2*length-1:x=96
  480.   LINE (0,y-1)-(15,y+16),2,bf
  481.   FOR i=0 TO 4
  482.     CIRCLE (7,y+7),2*(4-i),i+3
  483.     PAINT (7,y+7),i+3,i+3
  484.   NEXT
  485.   GET(0,y-1)-(15,y+16),ml
  486.   FOR i=0 TO 19:PUT(16*i,y-1),ml,PSET:NEXT
  487.   LINE (x-1,y)-STEP(0,15),0
  488.   GOTO endit
  489. z4:
  490.   LINE (x,y)-(x+7,y+7),2,bf
  491.   FOR i=0 TO 4
  492.     LINE (x+i,y)-(x+7-i,y+7),i+3
  493.     LINE (x,y+i)-(x+7,y+7-i),i+3
  494.   NEXT
  495. finish:
  496.   GET(x,y)-(x+7,y+7),ml
  497.   FOR i=0 TO length/8-1:PUT(x+8*i,y),ml,PSET:NEXT
  498. endit:
  499.   drawmode& 4
  500.   printat& x,y,SADD(text$+nl$)
  501.   drawmode& 1
  502. END SUB
  503.  
  504. SUB cycle(start,num) STATIC
  505.   SHARED cRGB&,rgb&,copy&
  506.   rgb& 0,cRGB&,start,num
  507.   temp=PEEKW(cRGB&)
  508.   copy& cRGB&+2,cRGB&,num,2
  509.   POKEW cRGB&+2*num-2,temp
  510.   rgb& 1,cRGB&,start,num
  511. END SUB
  512.